home *** CD-ROM | disk | FTP | other *** search
/ Windows Game Programming for Dummies (2nd Edition) / WinGamProgFD.iso / pc / DirectX SDK / DXSDK / samples / Multimedia / VBSamples / DirectDraw / Tutorials / Tut2 / DDtut2.frm (.txt) next >
Encoding:
Visual Basic Form  |  2001-10-08  |  10.6 KB  |  281 lines
  1. VERSION 5.00
  2. Begin VB.Form DDTransparentBlt 
  3.    BorderStyle     =   3  'Fixed Dialog
  4.    Caption         =   "DD Transparency"
  5.    ClientHeight    =   5070
  6.    ClientLeft      =   630
  7.    ClientTop       =   630
  8.    ClientWidth     =   6495
  9.    BeginProperty Font 
  10.       Name            =   "Courier New"
  11.       Size            =   72
  12.       Charset         =   0
  13.       Weight          =   400
  14.       Underline       =   0   'False
  15.       Italic          =   -1  'True
  16.       Strikethrough   =   0   'False
  17.    EndProperty
  18.    Icon            =   "DDtut2.frx":0000
  19.    LinkTopic       =   "Form1"
  20.    MaxButton       =   0   'False
  21.    MinButton       =   0   'False
  22.    ScaleHeight     =   338
  23.    ScaleMode       =   3  'Pixel
  24.    ScaleWidth      =   433
  25.    Begin VB.PictureBox Picture1 
  26.       FillStyle       =   7  'Diagonal Cross
  27.       BeginProperty Font 
  28.          Name            =   "MS Sans Serif"
  29.          Size            =   18
  30.          Charset         =   0
  31.          Weight          =   400
  32.          Underline       =   0   'False
  33.          Italic          =   0   'False
  34.          Strikethrough   =   0   'False
  35.       EndProperty
  36.       Height          =   5055
  37.       Left            =   0
  38.       ScaleHeight     =   4995
  39.       ScaleWidth      =   6435
  40.       TabIndex        =   0
  41.       Top             =   0
  42.       Width           =   6495
  43.    End
  44. Attribute VB_Name = "DDTransparentBlt"
  45. Attribute VB_GlobalNameSpace = False
  46. Attribute VB_Creatable = False
  47. Attribute VB_PredeclaredId = True
  48. Attribute VB_Exposed = False
  49. Option Explicit
  50. 'NOTE THIS SAMPLES SHOWS HOW TO BLIT TO AREAS OF THE SCREEN
  51. Dim objDX               As New DirectX7
  52. Dim objDD               As DirectDraw7
  53. Dim objDDLakeSurf       As DirectDrawSurface7
  54. Dim objDDSpriteSurf     As DirectDrawSurface7
  55. Dim objDDScreen         As DirectDrawSurface7
  56. Dim objDDBackBuffer     As DirectDrawSurface7
  57. Dim objDDClip           As DirectDrawClipper
  58. Dim ddsdLake        As DDSURFACEDESC2
  59. Dim ddsdSprite      As DDSURFACEDESC2
  60. Dim ddsdScreen      As DDSURFACEDESC2
  61. Dim ddsdBackBuffer  As DDSURFACEDESC2
  62. Dim rBackBuffer     As RECT
  63. Dim rLake           As RECT
  64. Dim rSprite         As RECT
  65. Dim lastX As Long
  66. Dim lastY As Long
  67. Dim fps As Single
  68. Dim running As Boolean
  69. Private sMedia As String
  70. Sub Init()
  71.         
  72.     Dim file As String
  73.     'The empty string parameter means use the active display
  74.     Set objDD = objDX.DirectDrawCreate("")
  75.     Me.Show
  76.     'Indicate the application will be a normal windowed application
  77.     'with the same display depth as the current display
  78.     Call objDD.SetCooperativeLevel(Me.hWnd, DDSCL_NORMAL)
  79.     '----- getting a surface that represents the screen
  80.         
  81.     'Indicate that the ddsCaps member is valid
  82.     ddsdScreen.lFlags = DDSD_CAPS
  83.     'Ask for the primary surface (one that is visible on the screen)
  84.     ddsdScreen.ddsCaps.lCaps = DDSCAPS_PRIMARYSURFACE
  85.     'Get the primary surface object
  86.     Set objDDScreen = objDD.CreateSurface(ddsdScreen)
  87.     'Create a clipper object
  88.     'Clippers are used to set the writable region of the screen
  89.     Set objDDClip = objDD.CreateClipper(0)
  90.     'Assoiciate the picture hwnd with the clipper
  91.     objDDClip.SetHWnd Picture1.hWnd
  92.     'Have the blts to the screen clipped to the Picture box
  93.     objDDScreen.SetClipper objDDClip
  94.     '----- creating an invisible  surface to draw to
  95.     '      use it as a compositing surface in system memory
  96.     'Indicate that we want to specify the ddscaps height and width
  97.     'The format of the surface (bits per pixel) will be the same
  98.     'as the primary
  99.     ddsdBackBuffer.lFlags = DDSD_CAPS Or DDSD_HEIGHT Or DDSD_WIDTH
  100.     'Indicate that we want a surface that is not visible and that
  101.     'we want it in system memory wich is plentiful as opposed to
  102.     'video memory
  103.     ddsdBackBuffer.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN Or DDSCAPS_SYSTEMMEMORY
  104.     'Specify the height and width of the surface to be the same
  105.     'as the picture box (note unit are in pixels)
  106.     ddsdBackBuffer.lWidth = Picture1.Width
  107.     ddsdBackBuffer.lHeight = Picture1.Height
  108.     'Create the requested surface
  109.     Set objDDBackBuffer = objDD.CreateSurface(ddsdBackBuffer)
  110.                                                                                 
  111.                                                                                 
  112.     'Change the current directory to be the media directory
  113.     sMedia = FindMediaDir("lake.bmp")
  114.     If sMedia = vbNullString Then sMedia = AddDirSep(CurDir)
  115.     InitSurfaces
  116.     rBackBuffer.Bottom = ddsdBackBuffer.lHeight
  117.     rBackBuffer.Right = ddsdBackBuffer.lWidth
  118.     'get the area of the bitmap we want ot blt
  119.     rLake.Bottom = ddsdLake.lHeight
  120.     rLake.Right = ddsdLake.lWidth
  121.     rSprite.Bottom = ddsdSprite.lHeight
  122.     rSprite.Right = ddsdSprite.lWidth
  123.     RepaintEntireBackground
  124.                                                     
  125.     running = True
  126.     Do While running
  127.         DoFrame
  128.         DoEvents
  129.     Loop
  130. End Sub
  131. 'copy the backround bitmap to the background surface
  132. Sub RepaintEntireBackground()
  133.     Call objDDBackBuffer.BltFast(0, 0, objDDLakeSurf, rLake, DDBLTFAST_WAIT)
  134. End Sub
  135. Sub InitSurfaces()
  136.     '----- loading a background image of the lake
  137.             
  138.     'Indicate that we want to create an offscreen surface
  139.     'An offscreen surface is one that is available in memory
  140.     '(video or system memory) but is not visible to the user
  141.     ddsdLake.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
  142.     ddsdLake.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  143.     ddsdLake.lWidth = Picture1.Width
  144.     ddsdLake.lHeight = Picture1.Height
  145.     'create the surface and load lake.bmp onto the surface
  146.     Set objDDLakeSurf = objDD.CreateSurfaceFromFile(sMedia & "lake.bmp", ddsdLake)
  147.                                                                         
  148.     'copy the background to the compositing surface
  149.     RepaintEntireBackground
  150.                                                                         
  151.     '----- loading a sprit image (face)
  152.     'load the bitmap into the second surface
  153.         
  154.     'specify that the ddsCaps field is valid
  155.     ddsdSprite.lFlags = DDSD_CAPS Or DDSD_WIDTH Or DDSD_HEIGHT
  156.     ddsdSprite.lWidth = 64
  157.     ddsdSprite.lHeight = 64
  158.     'indicate we want an offscreen surface
  159.     ddsdSprite.ddsCaps.lCaps = DDSCAPS_OFFSCREENPLAIN
  160.     'create the surface
  161.     'since we are not specifying the height and width
  162.     'the bitmap will be the same size as the bitmap
  163.     Set objDDSpriteSurf = objDD.CreateSurfaceFromFile(sMedia & "disk1.bmp", ddsdSprite)
  164.     '----- setting the transparent color of the sprite
  165.     Dim key As DDCOLORKEY
  166.     'You can set a range of colors to be the
  167.     'here we set it to white
  168.     'CreateColor take 3 singles representing ranging from 0 to 1
  169.     'for red green and blue components of the color
  170.     key.low = 0
  171.     key.high = 0
  172.     'Assign the transparent color to the sprite object
  173.     'DDCKEY_SRCBLT specifies that when a blt is done the
  174.     'transparent color is associated with the surface being
  175.     'blitted and not the one being blitted to
  176.     objDDSpriteSurf.SetColorKey DDCKEY_SRCBLT, key
  177. End Sub
  178. Sub DoFrame()
  179.     Dim ddrval As Long
  180.     Dim rPrim As RECT
  181.     Dim x As Single
  182.     Dim y As Single
  183.     Static a As Single
  184.     Static t1 As Single
  185.     Static t2 As Single
  186.     Static i As Integer
  187.     Static tLast As Single
  188.     Static tNow As Single
  189.                 
  190.     'calculate the angle of where we place the sprite
  191.     t2 = Timer
  192.     If t1 <> 0 Then
  193.         
  194.         a = a + (t2 - t1) * 100
  195.         If a > 360 Then a = a - 360
  196.     End If
  197.     t1 = t2
  198.         
  199.     Dim bRestore As Boolean
  200.     ' this will keep us from trying to blt in case we lose the surfaces (another fullscreen app takes over)
  201.     bRestore = False
  202.     Do Until ExModeActive
  203.         DoEvents
  204.         bRestore = True
  205.     Loop
  206.     ' if we lost and got back the surfaces, then restore them
  207.     DoEvents
  208.     If bRestore Then
  209.         bRestore = False
  210.         objDD.RestoreAllSurfaces
  211.         InitSurfaces ' must init the surfaces again if they we're lost
  212.     End If
  213.     'calculate FPS
  214.     i = i + 1
  215.     If i = 30 Then
  216.         tNow = Timer
  217.         If tNow <> tLast Then
  218.             fps = 30 / (Timer - tLast)
  219.             tLast = Timer
  220.             i = 0
  221.             Me.Caption = "DD Transparency    Frames per Second =" + Format$(fps, "#.0")
  222.         End If
  223.     End If
  224.     'calculate the x y coordinate of where we place the sprite
  225.     x = Cos((a / 360) * 2 * 3.141) * Picture1.Width / 8
  226.     y = Sin((a / 360) * 2 * 3.141) * Picture1.Height / 8
  227.     x = x + Picture1.Width / 2
  228.     y = y + Picture1.Height / 2
  229.     'clean up background from last frame
  230.     'by only reparing the background where it needs to
  231.     'be you wont need to reblit the whole thing
  232.     Dim rClean As RECT
  233.     If lastX <> 0 Then
  234.         rClean.Left = lastX
  235.         rClean.Top = lastY
  236.         rClean.Right = lastX + ddsdSprite.lWidth
  237.         rClean.Bottom = lastY + ddsdSprite.lHeight
  238.         Call objDDBackBuffer.BltFast(lastX, lastY, objDDLakeSurf, rClean, DDBLTFAST_WAIT)
  239.     End If
  240.     lastX = x
  241.     lastY = y
  242.     'blt to the backbuffer from our  sprite
  243.     'use the color key on the source - (our sprite)
  244.     'wait for the blt to finish before moving one
  245.     Dim rtemp As RECT
  246.     rtemp.Left = x
  247.     rtemp.Top = y
  248.     rtemp.Right = x + ddsdSprite.lWidth
  249.     rtemp.Bottom = y + ddsdSprite.lHeight
  250.     objDDBackBuffer.Blt rtemp, objDDSpriteSurf, rSprite, DDBLT_KEYSRC Or DDBLT_WAIT
  251.         
  252.     'Get the position of our picture box in screen coordinates
  253.     objDX.GetWindowRect Picture1.hWnd, rPrim
  254.     'blt our back buffer to the screen
  255.     Call objDDScreen.Blt(rPrim, objDDBackBuffer, rBackBuffer, DDBLT_WAIT)
  256. End Sub
  257. Private Sub Form_Load()
  258.     Init
  259. End Sub
  260. Private Sub Form_Resize()
  261.     'This tutorial does not handle resize
  262.     'To resize we would need to recreate the backbuffer
  263.     'The lake bitmap would have to be larger as well
  264.     'for the dirty rectangle clean up to be correct.
  265. End Sub
  266. Private Sub Form_Unload(Cancel As Integer)
  267.     running = False
  268. End Sub
  269. Private Sub Picture1_Paint()
  270.     DoFrame
  271. End Sub
  272. Function ExModeActive() As Boolean
  273.     Dim TestCoopRes As Long
  274.     TestCoopRes = objDD.TestCooperativeLevel
  275.     If (TestCoopRes = DD_OK) Then
  276.         ExModeActive = True
  277.     Else
  278.         ExModeActive = False
  279.     End If
  280. End Function
  281.